From 27fb00609c6781c94f863a06d29d20e0a9753af1 Mon Sep 17 00:00:00 2001 From: Camm Maguire Date: Tue, 23 Jun 2026 18:56:31 +0000 Subject: [PATCH] [PATCH] TODO: Put a short summary on the line above and replace this paragraph with a longer explanation of this change. Complete the meta-information with other relevant fields (see below for details). To make it easier, the information below has been extracted from the changelog. Adjust it or drop it. Gbp-Pq: Name Version_2_7_2pre30 --- Makefile.am | 12 ++-- Makefile.in | 89 +++++++++++++++-------- ansi-tests/compile-file.lsp | 11 +-- ansi-tests/gclload.lsp | 3 +- cmpnew/gcl_cmpeval.lsp | 6 +- cmpnew/gcl_cmpmain.lsp | 10 ++- cmpnew/gcl_cmptop.lsp | 5 +- configure | 45 ++++++++---- configure.ac | 23 ++++-- gcl-tk/tkl.lisp | 2 +- git.tag | 2 +- h/error.h | 8 --- h/gclincl.h.in | 6 +- h/notcomp.h | 2 + h/object.h | 6 +- h/pool.h | 1 + h/protoize.h | 4 ++ lsp/gcl_iolib.lsp | 10 +-- o/alloc.c | 2 + o/assignment.c | 2 +- o/cfun.c | 22 +++++- o/cmpaux.c | 8 ++- o/disable_aslr.c | 139 ++++++++++++++++++++++++++++++++++++ o/error.c | 2 +- o/eval.c | 13 ++-- o/file.d | 10 ++- o/gbc.c | 6 +- o/gmp.c | 2 +- o/main.c | 110 +++++++++++----------------- o/nsocket.c | 2 +- o/num_rand.c | 2 +- o/save.c | 69 +++++++++++++++--- o/sgbc.c | 3 +- o/unexmacosx.c | 5 +- o/unixfsys.c | 6 +- o/unixsave.c | 5 +- o/usig2.c | 2 +- 37 files changed, 469 insertions(+), 186 deletions(-) create mode 100644 o/disable_aslr.c diff --git a/Makefile.am b/Makefile.am index 23c904ff..12c526d5 100644 --- a/Makefile.am +++ b/Makefile.am @@ -158,7 +158,7 @@ C_SRC=o/typespec.c o/alloc.c o/gbc.c o/main.c o/eval.c o/macros.c o/lex.c o/bds o/unixfsys.c o/unixfasl.c o/error.c o/unixtime.c o/unixsys.c o/unixsave.c o/funlink.c o/fat_string.c\ o/run_process.c o/usig.c o/usig2.c o/utils.c o/makefun.c o/sockets.c o/gmp_wrappers.c\ o/nsocket.c o/prelink.c o/sfasl.c o/msbrk.c \ - o/user_init.c o/user_match.c o/mapfun.c + o/user_init.c o/user_match.c o/mapfun.c o/disable_aslr.c # o/bitop.c o/nfunlink.c o/clxsocket.c # o/bcmp.c o/bcopy.c o/bzero.c @@ -260,7 +260,7 @@ unixport/saved_%: | unixport/raw_% unixport/gcl_cmpnopt_%.lsp \ echo "(system:save-system \"../$@\")" | \ cat ../unixport/init_raw.lsp prof_init.lsp - | \ GCL_LSPSYSDIR=../$(srcdir)/unixport/ \ - ../unixport/raw_$* $$(dirname $$(pwd))/unixport/ -libdir $$(dirname $$(pwd))/ && \ + ../unixport/raw_$* unixport/ -libdir ./ && \ rm -f ../unixport/gcl_cmpnopt.lsp rm -rf sb_$* @@ -605,14 +605,16 @@ info/gcl%.texi: info/gcl.texi touch $@ %.info: %.texi | xbin/mktmp # FIXME parallel ugliness - i=$$($| $@);ln -f $< $$i;$(MAKEINFO) $$i --output $@;rm -f $$i + i=$$($| $@);ln -f $< $$i;mkdir $$i.d;cp $(" + (let ((s (namestring si::*current-directory*))) + (subseq s 0 (1- (length s))))))) (declare (special *c-debug*)) (format nil "~a ~a -I~a ~a ~a -c ~a -o ~a" (concatenate 'string diff --git a/cmpnew/gcl_cmptop.lsp b/cmpnew/gcl_cmptop.lsp index 9caef52e..4d3caa66 100644 --- a/cmpnew/gcl_cmptop.lsp +++ b/cmpnew/gcl_cmptop.lsp @@ -179,8 +179,7 @@ (defun init-name (p &optional sp) (if sp - (let* ((p (truename p)) - (pn (pathname-name p)) + (let* ((pn (pathname-name p)) (g (zerop (si::string-match #v"^gcl_" pn)))) (dash-to-underscore (namestring @@ -200,7 +199,7 @@ (dash-to-underscore fname) "__" (if (boundp '*compiler-input*) - (subseq *init-name* 4) + *init-name* ""))))) (defvar *top-form* nil) diff --git a/configure b/configure index 30325345..6e8ab502 100755 --- a/configure +++ b/configure @@ -663,7 +663,6 @@ TCLSH HAVE_SIGEMT HAVE_SIGSYS HAVE_SV_ONSTACK -USE_CLEANUP HAVE_PUTENV HAVE_SETENV NO_PROFILE @@ -813,6 +812,7 @@ enable_debug enable_static enable_pic enable_dependency_tracking +enable_aslr enable_text_base enable_segment_alignment_bits enable_initial_heap_vmsize @@ -1493,6 +1493,7 @@ Optional Features: do not reject slow dependency extractors --disable-dependency-tracking speeds up one-time build + --disable-aslr will ensure reproducible builds and/or work around absent no-pie --enable-text_base=0x.... set base address for __TEXT --enable-segment_alignment_bits=... set bit alignment for mach-o image segments --enable-initial_heap_vmsize=0x.... set heap size for raw images @@ -7442,6 +7443,35 @@ add_args_to_cflags -fsigned-char -pipe -fcommon \ add_args_to_ldflags -no-pie -Wl,-z,relro # -Wl,-z,lazy +# Check whether --enable-aslr was given. +if test ${enable_aslr+y} +then : + enableval=$enable_aslr; enable_aslr=$enableval +else case e in #( + e) enable_asrl="yes" ;; +esac +fi + + +{ printf '%s\n' "$as_me:${as_lineno-$LINENO}: checking whether aslr must be disabled due to absent -no-pie" >&5 +printf %s "checking whether aslr must be disabled due to absent -no-pie... " >&6; } +if ! echo $LDFLAGS |grep -q -w '\-no\-pie'; then + { printf '%s\n' "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf '%s\n' "yes" >&6; } + enable_aslr="no" +else + { printf '%s\n' "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf '%s\n' "no" >&6; } +fi + +if test "$enable_aslr" != "yes" ; then + +printf '%s\n' "#define DISABLE_ASLR 1" >>confdefs.h + +fi + + + { printf '%s\n' "$as_me:${as_lineno-$LINENO}: checking for inline semantics" >&5 printf %s "checking for inline semantics... " >&6; } cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -11577,16 +11607,6 @@ fi fi -ac_fn_c_check_func "$LINENO" "_cleanup" "ac_cv_func__cleanup" -if test "x$ac_cv_func__cleanup" = xyes -then : - -printf '%s\n' "#define USE_CLEANUP 1" >>confdefs.h - -fi - - - { printf '%s\n' "$as_me:${as_lineno-$LINENO}: checking FIONBIO vs. O_NONBLOCK for nonblocking I/O" >&5 printf %s "checking FIONBIO vs. O_NONBLOCK for nonblocking I/O... " >&6; } @@ -12142,7 +12162,8 @@ LI_GITTAG="$GIT_TAG" LI_RELEASE="$RELEASE" #LI_CC="\"$GCL_CC -c `echo " $FINAL_CFLAGS $LISP_CFLAGS" | sed 's,-pg\b,,g'`\"" -LI_CC="\"$GCL_CC -c `echo " $FINAL_CFLAGS" | sed 's,-pg\b,,g'`\"" +STRIP_FINAL_CFLAGS=`echo $FINAL_CFLAGS | sed "s,$(pwd),,g"` +LI_CC="\"$GCL_CC -c `echo " $STRIP_FINAL_CFLAGS" | sed 's,-pg\b,,g'`\"" LI_DFP="\"$GPL_FLAG\"" diff --git a/configure.ac b/configure.ac index bf620e4f..2c783f30 100644 --- a/configure.ac +++ b/configure.ac @@ -286,6 +286,23 @@ add_args_to_cflags -fsigned-char -pipe -fcommon \ add_args_to_ldflags -no-pie -Wl,-z,relro # -Wl,-z,lazy +AC_ARG_ENABLE([aslr],[ --disable-aslr will ensure reproducible builds and/or work around absent no-pie], + [enable_aslr=$enableval],[enable_asrl="yes"]) + +AC_MSG_CHECKING([whether aslr must be disabled due to absent -no-pie]) +if ! echo $LDFLAGS |grep -q -w '\-no\-pie'; then + AC_MSG_RESULT([yes]) + enable_aslr="no" +else + AC_MSG_RESULT([no]) +fi + +if test "$enable_aslr" != "yes" ; then + AC_DEFINE([DISABLE_ASLR],[1],[disable aslr]) +fi + + + AC_MSG_CHECKING([for inline semantics]) AC_COMPILE_IFELSE( [AC_LANG_SOURCE([[ @@ -1739,9 +1756,6 @@ if test "$no_setenv" = "1" ; then AC_SUBST(HAVE_PUTENV) fi -AC_CHECK_FUNC(_cleanup, [AC_DEFINE(USE_CLEANUP,1,[have _cleanup function])],) -AC_SUBST(USE_CLEANUP) - AC_MSG_CHECKING([FIONBIO vs. O_NONBLOCK for nonblocking I/O]) case $system in @@ -1948,7 +1962,8 @@ AC_SUBST(LI_GITTAG) LI_RELEASE="$RELEASE" AC_SUBST(LI_RELEASE) #LI_CC="\"$GCL_CC -c `echo " $FINAL_CFLAGS $LISP_CFLAGS" | sed 's,-pg\b,,g'`\"" -LI_CC="\"$GCL_CC -c `echo " $FINAL_CFLAGS" | sed 's,-pg\b,,g'`\"" +STRIP_FINAL_CFLAGS=`echo $FINAL_CFLAGS | sed "s,$(pwd),,g"` +LI_CC="\"$GCL_CC -c `echo " $STRIP_FINAL_CFLAGS" | sed 's,-pg\b,,g'`\"" AC_SUBST(LI_CC) LI_DFP="\"$GPL_FLAG\"" AC_SUBST(LI_DFP) diff --git a/gcl-tk/tkl.lisp b/gcl-tk/tkl.lisp index 08649ec6..86d35c9a 100644 --- a/gcl-tk/tkl.lisp +++ b/gcl-tk/tkl.lisp @@ -1496,7 +1496,7 @@ on ~a as in: ~s~%" host command ))) (format st "~%(in-package ~s)" (package-name *package*)) (dolist (v lis) (get-file-autoloads v st)) (format st "~%(in-package ~s)" (package-name *package*)) - (format st "~2%~s" `(setq si::*load-path* (append ',*paths* si::*load-path*))) + ;(format st "~2%~s" `(setq si::*load-path* (append ',*paths* si::*load-path*))) )) diff --git a/git.tag b/git.tag index 76fff234..b5a6fe3b 100644 --- a/git.tag +++ b/git.tag @@ -1 +1 @@ -"Version_2_7_2pre28" +"Version_2_7_2pre30" diff --git a/h/error.h b/h/error.h index e6f7a4ac..c3f02299 100644 --- a/h/error.h +++ b/h/error.h @@ -191,12 +191,4 @@ object ihs_top_function_name(ihs_ptr h); #define ASSERT(a_) do {if (!(a_)) NERROR("The assertion " #a_ " failed");} while (0) -#define gcl_abort() ({\ - frame_ptr fr=frs_sch_catch(sSPtop_abort_tagP->s.s_dbind);\ - vs_base[0]=sSPtop_abort_tagP->s.s_dbind;\ - vs_top=vs_base+1;\ - if (fr) unwind(fr,sSPtop_abort_tagP->s.s_dbind);\ - abort();\ - }) - #endif /*ERROR_H*/ diff --git a/h/gclincl.h.in b/h/gclincl.h.in index c2209a14..2c8078e8 100644 --- a/h/gclincl.h.in +++ b/h/gclincl.h.in @@ -15,6 +15,9 @@ /* debug safecdr code */ #undef DEBUG_SAFE_CDR +/* disable aslr */ +#undef DISABLE_ASLR + /* big endian word order */ #undef DOUBLE_BIGENDIAN @@ -335,9 +338,6 @@ backward compatibility; new code need not use it. */ #undef STDC_HEADERS -/* have _cleanup function */ -#undef USE_CLEANUP - /* use fionbio for non-blocking io */ #undef USE_FIONBIO diff --git a/h/notcomp.h b/h/notcomp.h index db45d2b5..7598d827 100755 --- a/h/notcomp.h +++ b/h/notcomp.h @@ -357,3 +357,5 @@ EXTER gmp_randfnptr_t Mersenne_Twister_Generator_Noseed; #define collect(p_,f_) (p_)=&(*(p_)=(f_))->c.c_cdr #define READ_STREAM_OR_FASD(strm_) \ type_of(strm_)==t_stream ? read_object_non_recursive(strm_) : fSread_fasd_top(strm_) + +#define NO_TRUENAME (raw_image || no_truename) diff --git a/h/object.h b/h/object.h index f6460730..a6cef3f2 100644 --- a/h/object.h +++ b/h/object.h @@ -422,7 +422,7 @@ EXTER long holepage; /* hole pages */ EXTER fixnum new_holepage,starting_hole_div,starting_relb_heap_mult; EXTER ulfixnum cumulative_allocation,recent_allocation; -EXTER ufixnum wait_on_abort; +EXTER ufixnum wait_on_abort,no_truename; EXTER double gc_alloc_min,mem_multiple,gc_page_min,gc_page_max; EXTER char *multiprocess_memory_pool; @@ -630,7 +630,7 @@ EXTER object sSlambda_block_expanded; # ifdef __GNUC__ # define assert(ex)\ {if (!(ex)){(void)fprintf(stderr, \ - "Assertion failed: file \"%s\", line %d\n", __FILE__, __LINE__);gcl_abort();}} + "Assertion failed: file \"%s\", line %d\n", __FILE__, __LINE__);do_gcl_abort();}} # else # define assert(ex) # endif @@ -652,7 +652,7 @@ EXTER object sSlambda_block_expanded; #define END_NO_INTERRUPT_SAFE \ signals_allowed = old_signals_allowed; \ if (signals_pending) \ - do{ if(signals_allowed ==0) /* should not get here*/gcl_abort(); \ + do{ if(signals_allowed ==0) /* should not get here*/do_gcl_abort(); \ raise_pending_signals(sig_safe)}while(0) diff --git a/h/pool.h b/h/pool.h index d1bf3959..646520f2 100644 --- a/h/pool.h +++ b/h/pool.h @@ -120,6 +120,7 @@ close_pool(void) { massert(!close(pool)); massert(!munmap(Pool,sizeof(struct pool))); pool=-1; + memset(gcl_pool,0,sizeof(gcl_pool)); } #endif diff --git a/h/protoize.h b/h/protoize.h index 07ab0e3c..687ccba8 100644 --- a/h/protoize.h +++ b/h/protoize.h @@ -1675,3 +1675,7 @@ int msbrk_init(void); int msbrk_end(void); object quick_call_function_vec(object,ufixnum,object *); int msbrk_initialized(void); +void *mdlopen(const char *,int); +void close_dlopen_list(void); +void set_global_env_defaults(void); +void disable_aslr(int,char **,char **); diff --git a/lsp/gcl_iolib.lsp b/lsp/gcl_iolib.lsp index 32056ada..f206330a 100644 --- a/lsp/gcl_iolib.lsp +++ b/lsp/gcl_iolib.lsp @@ -456,17 +456,17 @@ (file-output-stream (when outp (c-stream-fp strm)))))) (defun load-pathname-exists (z) - (or (probe-file z) - (when *allow-gzipped-file* - (when (probe-file (string-concatenate (namestring z) ".gz")) - z)))) + (when (or (probe-file z) + (when *allow-gzipped-file* + (probe-file (string-concatenate (namestring z) ".gz")))) + z)) (defun load-pathname (p print if-does-not-exist external-format &aux (pp (merge-pathnames p)) (epp (reduce (lambda (y x) (or y (load-pathname-exists (translate-pathname x "" p)))) '(#P".o" #P".lsp" #P".lisp" #P"") :initial-value nil)));FIXME newest? (if epp - (let* ((*load-pathname* pp)(*load-truename* epp)) + (let* ((*load-pathname* pp)(*load-truename* (or (probe-file epp) epp))) (with-open-file (s epp :external-format external-format) (if (member (peek-char nil s nil 'eof) '#.(mapcar 'code-char (list 127 #xcf #xce #x4c #x64))) diff --git a/o/alloc.c b/o/alloc.c index c38a329b..ca38f530 100644 --- a/o/alloc.c +++ b/o/alloc.c @@ -1737,6 +1737,7 @@ free(void *ptr) { for (p = &malloc_list,pp=*p; pp && !endp(pp); p = &((pp)->c.c_cdr),pp=pp->c.c_cdr) if ((pp)->c.c_car->st.st_self == ptr) { + memset((pp)->c.c_car->st.st_self,0,(pp)->c.c_car->st.st_dim); (pp)->c.c_car->st.st_self = NULL; *p = pp->c.c_cdr; return; @@ -1782,6 +1783,7 @@ realloc(void *ptr, size_t size) { VFILLP_SET(x,size); return(ptr); } else { + memset(x->st.st_self,0,x->st.st_dim); x->st.st_self = alloc_contblock(size); x->st.st_dim = size; VSET_MAX_FILLP(x); diff --git a/o/assignment.c b/o/assignment.c index 34ea4423..17d26d34 100644 --- a/o/assignment.c +++ b/o/assignment.c @@ -192,7 +192,7 @@ DEFUN("FSET",object,fSfset,SI,2,2,NONE,OO,OO,OO,OO,(object sym,object function), if (function->fun.fun_plist!=Cnil) { function->fun.fun_plist->c.c_cdr->c.c_cdr->c.c_cdr->c.c_cdr->c.c_cdr->c.c_car=sym;/*FIXME*/ x=function->fun.fun_plist->c.c_cdr->c.c_cdr->c.c_cdr->c.c_car; - function->fun.fun_plist->c.c_cdr->c.c_cdr->c.c_cdr->c.c_car=x==Cnil ? sLAload_truenameA->s.s_dbind : x; + function->fun.fun_plist->c.c_cdr->c.c_cdr->c.c_cdr->c.c_car=x==Cnil ? sLAload_pathnameA->s.s_dbind : x; } RETURN1(function); diff --git a/o/cfun.c b/o/cfun.c index f6e3c725..c2aaf07b 100644 --- a/o/cfun.c +++ b/o/cfun.c @@ -73,7 +73,27 @@ DEFUN("CFDL",object,fScfdl,SI,0,0,NONE,OO,OO,OO,OO,(void),"") { } RETURN1(Cnil); } - + +DEFVAR("*DLOPEN-HANDLES*",sSAdlopen_handlesA,SI,Cnil,""); + +void +close_dlopen_list(void) { + for (;sSAdlopen_handlesA->s.s_dbind!=Cnil;sSAdlopen_handlesA->s.s_dbind=sSAdlopen_handlesA->s.s_dbind->c.c_cdr) + dlclose((void *)fix(sSAdlopen_handlesA->s.s_dbind->c.c_car)); +} + +void * +mdlopen(const char *name,int flags) { + void *v=dlopen(name,flags); + if (name) { + object x=sSAdlopen_handlesA->s.s_dbind; + for (;x!=Cnil && fix(x->c.c_car)!=(fixnum)v;x=x->c.c_cdr); + if (x==Cnil) + sSAdlopen_handlesA->s.s_dbind=MMcons(make_fixnum((fixnum)v),sSAdlopen_handlesA->s.s_dbind); + } + return v; +} + DEFUN("DLSYM",object,fSdlsym,SI,2,2,NONE,OI,OO,OO,OO,(fixnum h,object name),"") { void *ad=0; diff --git a/o/cmpaux.c b/o/cmpaux.c index 66378f3e..6828dfa8 100644 --- a/o/cmpaux.c +++ b/o/cmpaux.c @@ -613,8 +613,12 @@ gcl_init_or_load1(void (*fn)(void),const char *file) { printf("Initializing %s\n",file);fflush(stdout); lpn=make_simple_string(file); - massert(realpath(file,FN1)); - ltn=make_simple_string(FN1); + if (NO_TRUENAME) + ltn=lpn; + else { + massert(realpath(file,FN1)); + ltn=make_simple_string(FN1); + } memory=new_cfdata(); memory->d.tt=1; memory->cfd.cfd_name=ltn; diff --git a/o/disable_aslr.c b/o/disable_aslr.c new file mode 100644 index 00000000..a84a6506 --- /dev/null +++ b/o/disable_aslr.c @@ -0,0 +1,139 @@ +#include "include.h" + +#ifdef DISABLE_ASLR + +#if defined(__APPLE__) + +#include +#include +#include +#include +#include + +#ifndef POSIX_SPAWN_DISABLE_ASLR +#define POSIX_SPAWN_DISABLE_ASLR 0x0100 +#endif + +void +disable_aslr(int argc, char **argv, char **envp) { + + pid_t pid; + posix_spawnattr_t attr; + + if (!_dyld_get_image_vmaddr_slide(0)) { + return; + } + + posix_spawnattr_init(&attr); + posix_spawnattr_setflags(&attr, POSIX_SPAWN_SETEXEC | POSIX_SPAWN_DISABLE_ASLR); + if (posix_spawn(&pid, argv[0], NULL, &attr, argv, envp)) { + perror("posix_spawn to disable ASLR failed"); + do_gcl_abort(); + } + posix_spawnattr_destroy(&attr); + +} + +#else + +#include +#include +#include + + +static inline void +reexec(int argc, char **argv, char **envp) { + + int i,j,k; + char **n,**a; + void *v; + + for (i=j=0;argv[i];i++) + j+=strlen(argv[i])+1; + for (k=0;envp[k];k++) + j+=strlen(envp[k])+1; + j+=(i+k+3)*sizeof(char *); + + msbrk_init(); + massert((v=sbrk(j))!=(void *)-1); + + a=v; + v=a+i+1; + n=v; + v=n+k+2; + + for (i=0;argv[i];i++) { + a[i]=v; + strcpy(v,argv[i]); + v+=strlen(v)+1; + } + a[i]=0; + + for (k=0;envp[k];k++) { + n[k]=v; + strcpy(v,envp[k]); + v+=strlen(v)+1; + } + n[k]="GCL_UNRANDOMIZE=t"; + n[k+1]=0; + + gcl_cleanup(0); + massert(execve(*a,a,n)!=-1); + +} + +#if defined(__linux__) + +#include +#include + +void +disable_aslr(int argc, char **argv, char **envp) { + + long pers; + long flag = ADDR_NO_RANDOMIZE|(sizeof(flag)==4 ? ADDR_LIMIT_3GB : 0); + + massert((pers=personality(-1))!=-1); + + /*READ_IMPLIES_EXEC is for selinux, but selinux will reset it in the child*/ + massert((pers=personality(READ_IMPLIES_EXEC|pers))!=-1); + + if ((pers & flag)!=flag && !getenv("GCL_UNRANDOMIZE")) { + + massert(personality(pers | flag)!=-1); + massert((personality(-1)&flag)==flag); + + reexec(argc,argv,envp); + + } + +} + +#elif defined(__FreeBSD_kernel__) + +#include + +void +disable_aslr(int argc, char **argv, char **envp) { + + const int cctl=PROC_ASLR_FORCE_DISABLE; + int stat,ctl=cctl; + + massert(procctl(P_PID, 0, PROC_ASLR_STATUS, &stat) != -1); + + if ((stat&cctl)!=cctl && !getenv("GCL_UNRANDOMIZE")) { + + massert(procctl(P_PID, 0, PROC_ASLR_CTL, &ctl) != -1); + massert(procctl(P_PID, 0, PROC_ASLR_STATUS, &stat) != -1); + massert((stat&cctl)==cctl); + + reexec(argc,argv,envp); + + } + +} +#endif + +#endif + +#endif diff --git a/o/error.c b/o/error.c index 5ab57b83..fa3e0d54 100644 --- a/o/error.c +++ b/o/error.c @@ -41,7 +41,7 @@ assert_error(const char *a,unsigned l,const char *f,const char *n) { make_simple_string(f),make_simple_string(n),make_simple_string(strerror(errno))); else { emsg("The assertion %s on line %d of %s in function %s failed: %s",a,l,f,n,strerror(errno)); - gcl_abort(); + do_gcl_abort(); } } diff --git a/o/eval.c b/o/eval.c index 4385466c..06fc758c 100644 --- a/o/eval.c +++ b/o/eval.c @@ -134,12 +134,17 @@ funcall_vec(object fun,fixnum n,object *b) { } +static object eval_vec[MAX_ARGS+1]; + +void +clear_eval_vec(void) { + memset(eval_vec,0,sizeof(eval_vec)); +} static object funcall_ap(object fun,fixnum n,va_list ap) { - static object b[MAX_ARGS+1]; - object *t=b; + object *t=eval_vec; ufixnum j=labs(n),i; for (i=j;i--;) @@ -148,11 +153,11 @@ funcall_ap(object fun,fixnum n,va_list ap) { object x=*--t; for (i=fun->fun.fun_minarg-(j-1);i--;*t++=x->c.c_car,x=x->c.c_cdr,n--) if (x==Cnil) - FEtoo_few_arguments(b,t); + FEtoo_few_arguments(eval_vec,t); *t++=x; } - return funcall_vec(fun,n,b); + return funcall_vec(fun,n,eval_vec); } diff --git a/o/file.d b/o/file.d index d48aff90..c1f9f9f8 100644 --- a/o/file.d +++ b/o/file.d @@ -1396,8 +1396,12 @@ load(const char *s) { filename = make_simple_string(s); vs_push(filename); - massert(realpath(s,FN2)); - tfn = make_simple_string(FN2); + if (NO_TRUENAME) + tfn=filename; + else { + massert(realpath(s,FN2)); + tfn = make_simple_string(FN2); + } bds_bind(sLAload_pathnameA,filename); bds_bind(sLAload_truenameA,tfn); @@ -1959,7 +1963,7 @@ DEFUN("SOCKET-INT",object,fSsocket_int,SI,7,7,NONE,OO,OO,OO,OO, exit(0); break; case -1: - gcl_abort(); + do_gcl_abort(); break; default: close_stream(y); diff --git a/o/gbc.c b/o/gbc.c index 94761c66..95ad23d6 100644 --- a/o/gbc.c +++ b/o/gbc.c @@ -813,7 +813,9 @@ mark_phase(void) { #ifndef N_RECURSION_REQD #define N_RECURSION_REQD 2 #endif - mark_c_stack(0,N_RECURSION_REQD,mark_stack_carefully); + + if (!saving_system) + mark_c_stack(0,N_RECURSION_REQD,mark_stack_carefully); } @@ -925,6 +927,8 @@ mark_c_stack(jmp_buf env1, int n, void (*fn)(void *,void *,int)) { } #endif + c_stack_where=NULL; + } static void diff --git a/o/gmp.c b/o/gmp.c index a8b783d0..36072072 100644 --- a/o/gmp.c +++ b/o/gmp.c @@ -10,7 +10,7 @@ static void *gcl_gmp_realloc(void *oldmem, size_t oldsize, size_t newsize) { unsigned int *old,*new; if (!jmp_gmp) { /* No gc in alloc if jmp_gmp */ - if (MP_SELF(big_gcprotect)) gcl_abort(); + if (MP_SELF(big_gcprotect)) do_gcl_abort(); MP_SELF(big_gcprotect)=oldmem; MP_ALLOCATED(big_gcprotect)=oldsize/MP_LIMB_SIZE; } diff --git a/o/main.c b/o/main.c index cd1cef28..5285df7a 100644 --- a/o/main.c +++ b/o/main.c @@ -333,18 +333,33 @@ acceptable_log_maxpage_bound(ufixnum l) { (void *)heap_end-data_start+CEI(rb_pointer-rb_begin(),PAGESIZE) < (1UL<<(l+1))); } +void +set_global_env_defaults(void) { + mem_multiple=1.0; + mem_bound=sizeof(fixnum)*8-1; + gc_alloc_min=0.05; + gc_page_min=0.5; + gc_page_max=0.75; + multiprocess_memory_pool=NULL; + wait_on_abort=0; + no_truename=0; +} + static void get_gc_environ(void) { const char *e; - mem_multiple=1.0; + set_global_env_defaults(); + + if (getenv("GCL_NO_TRUENAME")) + no_truename=1; + if ((e=getenv("GCL_MEM_MULTIPLE"))) { massert(sscanf(e,"%lf",&mem_multiple)==1); massert(mem_multiple>=0.0); } - mem_bound=sizeof(fixnum)*8-1; if ((e=getenv("GCL_MEM_BOUND"))) { ufixnum f; massert(sscanf(e,"%lud",&f)==1); @@ -354,19 +369,16 @@ get_gc_environ(void) { } } - gc_alloc_min=0.05; if ((e=getenv("GCL_GC_ALLOC_MIN"))) { massert(sscanf(e,"%lf",&gc_alloc_min)==1); massert(gc_alloc_min>=0.0); } - gc_page_min=0.5; if ((e=getenv("GCL_GC_PAGE_MIN"))||(e=getenv("GCL_GC_PAGE_THRESH"))) {/*legacy support*/ massert(sscanf(e,"%lf",&gc_page_min)==1); massert(gc_page_min>=0.0); } - gc_page_max=0.75; if ((e=getenv("GCL_GC_PAGE_MAX"))) { massert(sscanf(e,"%lf",&gc_page_max)==1); massert(gc_page_max>=0.0); @@ -377,7 +389,6 @@ get_gc_environ(void) { (*multiprocess_memory_pool=='t' || *multiprocess_memory_pool=='T'))/*GCL 2.6 compatability*/ multiprocess_memory_pool=getenv("HOME"); - wait_on_abort=0; if ((e=getenv("GCL_WAIT_ON_ABORT"))) massert(sscanf(e,"%lu",&wait_on_abort)==1); @@ -574,7 +585,7 @@ init_boot(void) { z=alloca(n); snprintf(z,n,"%-*.*s%s",(int)m,(int)m,d,s); #ifdef USE_LIBBOOT - if (!(v=dlopen(z,RTLD_LAZY|RTLD_GLOBAL))) + if (!(v=mdlopen(z,RTLD_LAZY|RTLD_GLOBAL))) printf("%s\n",dlerror()); if (!(q=dlsym(v,"gcl_init_boot"))) printf("%s\n",dlerror()); @@ -617,17 +628,20 @@ gcl_mprotect(void *v,unsigned long l,int p) { DEFVAR("*CODE-BLOCK-RESERVE*",sSAcode_block_reserveA,SI,Cnil,""); -#define HAVE_GCL_CLEANUP - void gcl_cleanup(int gc) { + frame_ptr fr; + if (getenv("GCL_WAIT")) sleep(30); -#if defined(USE_CLEANUP) - {extern void _cleanup(void);_cleanup();} -#endif + if (sSPtop_abort_tagP && sSPtop_abort_tagP->s.s_dbind!=Cnil) { + fr=frs_sch_catch(sSPtop_abort_tagP->s.s_dbind); + vs_base[0]=sSPtop_abort_tagP->s.s_dbind; + vs_top=vs_base+1; + if (fr) unwind(fr,sSPtop_abort_tagP->s.s_dbind); + } #ifdef USE_GPROF gprof_cleanup(); @@ -655,14 +669,14 @@ gcl_cleanup(int gc) { static char *stack_to_be_allocated; int -stack_ret(char *s,unsigned long size) { +stack_ret(volatile char *s,unsigned long size) { int r,i; for (i=r=0;i1); - for (s=NULL;(s=strtok(s ? NULL : FN1,":"));) { - - massert(snprintf(FN2,sizeof(FN2),"%s/%s",s,n)); - if (mbin(FN2,o)) - return 1; - - } - - return 0; - -} - -#endif - DEFUN("KCL-SELF",object,fSkcl_self,SI,0,0,NONE,OO,OO,OO,OO,(void),"") { return make_simple_string(kcl_self); } -#if defined(__APPLE__) -#include "disable_mac_aslr.h" -#endif - int main(int argc, char **argv, char **envp) { - GET_FULL_PATH_SELF(kcl_self); - *argv=kcl_self; +#ifdef DISABLE_ASLR + disable_aslr(argc,argv,envp); +#endif + +#include "cstack.h" + + kcl_self=*argv; vs_top = vs_base = vs_org; ihs_top = ihs_org-1; bds_top = bds_org-1; frs_top = frs_org-1; -#if defined(__APPLE__) - disable_aslr(argc, argv, envp); -#endif - -#include "cstack.h" - gcl_init_alloc(alloca(1)); setbuf(stdin, stdin_buf); @@ -848,7 +822,7 @@ error(char *s) printf("\nUnrecoverable error: %s.\n", s); fflush(stdout); #ifdef UNIX - gcl_abort(); + do_gcl_abort(); #endif } diff --git a/o/nsocket.c b/o/nsocket.c index 1525e2d9..592faf57 100644 --- a/o/nsocket.c +++ b/o/nsocket.c @@ -61,7 +61,7 @@ #endif #define VOID void -#define ERROR_MESSAGE(msg) do{ emsg(msg); gcl_abort() ; } while(0) +#define ERROR_MESSAGE(msg) do{ emsg(msg); do_gcl_abort() ; } while(0) #ifdef STAND diff --git a/o/num_rand.c b/o/num_rand.c index c295b49f..6355c4f1 100644 --- a/o/num_rand.c +++ b/o/num_rand.c @@ -79,7 +79,7 @@ rando(object x, object rs) { #ifdef UNIX -#define RS_DEF_INIT time(0) +#define RS_DEF_INIT ({char *e=getenv("SOURCE_DATE_EPOCH");e ? strtoul(e,NULL,10) : time(0);}) #else #define RS_DEF_INIT 0 #endif diff --git a/o/save.c b/o/save.c index 6883a239..c9de258c 100644 --- a/o/save.c +++ b/o/save.c @@ -1,4 +1,6 @@ /* Copyright (C) 2024 Camm Maguire */ +#define NO_PRELINK_UNEXEC_DIVERSION + #ifndef FIRSTWORD #include "include.h" #endif @@ -13,25 +15,76 @@ memory_save(char *original_file, char *save_file) unexec(save_file,original_file,0,0,0); } -#ifdef USE_CLEANUP -extern void _cleanup(); -#endif - LFD(siLsave)(void) { extern char *kcl_self; + extern void *shared_lib_start; + extern jmp_buf gmp_jmp; check_arg(1); + memset(FN1,0,sizeof(FN1)); + coerce_to_filename(vs_base[0], FN1); + + close_dlopen_list(); + frs_top=frs_org-1; gcl_cleanup(1); - coerce_to_filename(vs_base[0], FN1); + /*FIXME clean this up when done*/ + set_global_env_defaults(); + shared_lib_start=NULL; + memset(gmp_jmp,0,sizeof(gmp_jmp)); + memset(frs_org,0,(frs_limit-frs_org)*sizeof(*frs_org)); + memset(bds_org,0,(bds_limit-bds_org)*sizeof(*bds_org)); + memset(ihs_org,0,(ihs_limit-ihs_org)*sizeof(*ihs_org)); + memset(vs_org,0,(vs_limit-vs_org)*sizeof(*vs_org)); + { +#if !defined(__APPLE__) + extern char **__environ; +#endif + extern FILE *rl_instream; + extern char *rl_line_buffer; + extern void clear_eval_vec(void); + +#if !defined(__APPLE__) + __environ=NULL; +#endif + rl_instream=NULL; + rl_readline_name=NULL; + rl_line_buffer=NULL; + rl_completion_entry_function=NULL; + stdin=NULL; + stdout=NULL; + stderr=NULL; + clear_eval_vec(); + cs_limit=NULL; + cs_base=NULL; + cs_org=NULL; + memset(FN2,0,sizeof(FN2)); + memset(FN3,0,sizeof(FN3)); + memset(FN4,0,sizeof(FN4)); + memset(FN5,0,sizeof(FN5)); + ENVP=NULL; + ARGV=NULL; + ARGC=0; + my_stdin=NULL; + my_stdout=NULL; + my_stderr=NULL; + my_rl_readline_name_ptr=NULL; + my_rl_completion_entry_function_ptr=NULL; + + } + + { + void *v=kcl_self; + kcl_self=NULL; #ifdef MEMORY_SAVE - MEMORY_SAVE(kcl_self,FN1); + MEMORY_SAVE(v,FN1); #else - memory_save(kcl_self, FN1); -#endif + memory_save(v, FN1); +#endif + } /* no return */ exit(0); diff --git a/o/sgbc.c b/o/sgbc.c index cbe2b89d..91542a60 100644 --- a/o/sgbc.c +++ b/o/sgbc.c @@ -147,7 +147,8 @@ sgc_mark_phase(void) { } #endif - mark_c_stack(0,N_RECURSION_REQD,mark_stack_carefully); + if (!saving_system) + mark_c_stack(0,N_RECURSION_REQD,mark_stack_carefully); } diff --git a/o/unexmacosx.c b/o/unexmacosx.c index 972eb8bc..57f2e3f3 100644 --- a/o/unexmacosx.c +++ b/o/unexmacosx.c @@ -864,7 +864,6 @@ typedef struct { typedef struct { uint32_t magic; /* 0xfade0b01 (CSMAGIC_BLOBWRAPPER) */ uint32_t length; /* Total length of header + CMS data */ - uint8_t zero[18040-30]; } CS_BlobWrapper; #include @@ -927,7 +926,7 @@ dump_code_signature(struct segment_command *le_seg, mpwrite(&mh,sizeof(mh),0); sb.magic=htonl(0xfade0cc0); - sb.length=htonl(ldc.datasize-sizeof(cms.zero)-2); + sb.length=htonl(ldc.datasize); sb.count=htonl(sizeof(bi)/sizeof(*bi)); mwrite(&sb,sizeof(sb)); @@ -1050,10 +1049,8 @@ dump_it () { } else if (strncmp (scp->segname, "__HEAP", 16) == 0) { - extern char *data_start; struct section *sectp = (struct section *) (scp + 1); unsigned long header_offset=curr_header_offset + sizeof (struct segment_command); - extern int in_pre_gcl;/*support libboot.so*/ if (core_end-data_start>heap_vmsize) unexec_error ("data exceeds __HEAP vmsize"); diff --git a/o/unixfsys.c b/o/unixfsys.c index a90a34b2..42b98cf1 100644 --- a/o/unixfsys.c +++ b/o/unixfsys.c @@ -289,7 +289,11 @@ DEFUN("READLINKAT",object,fSreadlinkat,SI,2,2,NONE,OI,OO,OO,OO,(fixnum d,object DEFUN("GETCWD",object,fSgetcwd,SI,0,0,NONE,OO,OO,OO,OO,(void),"") { - massert(getcwd(FN1,sizeof(FN1))); + if (NO_TRUENAME) + massert(snprintf(FN1,sizeof(FN1),"./")>=0); + else + massert(getcwd(FN1,sizeof(FN1))); + RETURN1(make_simple_string(FN1)); } diff --git a/o/unixsave.c b/o/unixsave.c index 20b5071b..c8e3f9e8 100644 --- a/o/unixsave.c +++ b/o/unixsave.c @@ -24,6 +24,8 @@ Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. unixsave.c */ +#define NO_PRELINK_UNEXEC_DIVERSION + #define IN_UNIXSAVE #ifndef FIRSTWORD #include "include.h" @@ -146,7 +148,8 @@ LFD(Lsave)() { check_arg(1); check_type_or_pathname_string_symbol_stream(&vs_base[0]); coerce_to_filename(vs_base[0], FN1); - + + shared_lib_start=NULL; _cleanup(); memory_save(kcl_self, FN1); diff --git a/o/usig2.c b/o/usig2.c index b61775a5..73b3879c 100644 --- a/o/usig2.c +++ b/o/usig2.c @@ -273,7 +273,7 @@ before_interrupt(struct save_for_interrupt *p,int allowed) { #include "usig2_aux.c" if (pp-p->save_objects>=(sizeof(p->save_objects)/sizeof(void *))) - gcl_abort(); + do_gcl_abort(); } -- 2.30.2